0 CLEAR4000:CLS:GOTO15
1 L(CL,RL)=(T*(3+RL))+R:RETURN
2 L(CL,RL)=(T*11)+R:RETURN
15 DIMDK$(52),PRE(52),SU$(4),CA$(13),CR(4,2),CL$(7,19,2),ND$(52)
20 DIMACES$(4),L(7,19),PL,RL,EF,CL,MC,TM,AC,L,T1,NC,FW,FP,SU,BS,TW,FE,T,C$,IN$,A$:GOSUB8000
30 PRINT"KLONDIKE SOLITAIRE":PRINT:PRINT "DO YOU NEED INSTRUCTIONS? ";
35 A$=INKEY$:TM=RND(1000):IFA$=""THEN35
36 IFA$<>"Y"ANDA$<>"N"THEN35
37 IFA$="Y"THENGOSUB5000
38 CLS
40 PRINT"INITIALIZING ... "
45 GOSUB1000
50 PRINT"SHUFFLING ... "
60 GOSUB1200
65 PRINT"DEALING ... "
70 GOSUB1500
80 GOSUB1700
90 T1=3
91 PRINT@T*0+16,"C=MORE CARDS";
92 PRINT@T*1+16,"D=MOVE FROM DECK";
93 PRINT@T*2+16,"COLUMN # TO MOVE";
94 PRINT@T*6+28,"WINS";:PRINT@T*7+28,WI;
100 RL=444:PRINT@RL,"";:IFND<1THENPRINT"NONE";:PRINT@RL+T,"   ";:PRINT@RL+64,"   ";:GOTO140
120 C$=ND$(T1):IN$=C$:GOSUB3070:GOSUB1300:RL=RL+T:GOSUB3090
140 PRINT@T*9+28,"CARD";:PRINT@T*10+28,T1;:PRINT@T*11+29,"OF";:PRINT@T*12+28,ND;
150 PRINT@T*15+0,"                            ";
152 IFNC>51THEN900
155 PRINT@T*14+0,"WHAT DO YOU WANT TO DO?  ";CHR$(8);
160 A$=INKEY$:IFA$="" THEN 160
170 IFA$="C"THENPRINT A$;:GOSUB300:GOTO100
180 IFA$="D"THENPRINT A$;:GOSUB350:GOTO100
190 IFA$>="1"ANDA$<="7"THENPRINT A$;:GOSUB 600:GOTO100
200 IFA$="Q"THEN900
210 GOTO160
300 REM GET MORE CARDS FROM DECK
310 IFT1=NDTHENT1=3:GOTO320
311 T1=T1+3
320 IFT1>NDTHENT1=ND
330 RETURN
350 REM MOVE FROM DECK TO A COLUMN
360 PRINT@T*15+0,"FROM DECK TO? ";
380 A$=INKEY$:IF (A$>="1" AND A$<="7") OR A$="A" THEN 390
381 GOTO380
390 IFA$="A"THENPRINT "ACES";:GOTO395
391 PRINTA$;
395 IFA$="A"THEN540
400 TW=VAL(A$)
410 FORPL=19TO1STEP-1
420 IFCL$(TW,PL,2)<>"   "THENTM=PL:PL=1:NEXT:PL=TM:GOTO460
430 NEXT
432 IFCL$(TW,1,2)="   " AND LEFT$(ND$(T1),1)="K" THENPL=0:GOTO500
440 GOSUB990
450 RETURN
460 BELOW$=CL$(TW,PL,2)
470 AB$=ND$(T1)
480 GOSUB 2000:REM CHECK IF MATCH
490 IFOK$="NO"THEN440
500 CL$(TW,PL+1,1)=ND$(T1)
510 CL$(TW,PL+1,2)=ND$(T1)
520 CL=TW:GOSUB 3100
525 GOSUB 2200:REM REPACK DECK
530 RETURN
540 REM PLAY DECK TO ACES
550 AB$=ND$(T1)
560 GOSUB2300:REM PLAY TO ACES
570 IFOK$="NO" THEN 440
580 GOTO525
600 REM MOVE FROM ONE COLUMN TO ANOTHER
610 FW=VAL(A$)
620 FORFE=1TO19
630 IFCL$(FW,FE,2)<>DN$THENTM=FE:FE=19:NEXT:FE=TM:GOTO660
640 NEXT
650 GOSUB990:RETURN
660 PRINT@T*15+0,"FROM COLUMN";FW;"TO? ";
680 A$=INKEY$:IF(A$>="1"ANDA$<="7")ORA$="A"THEN690
681 GOTO680
690 IFA$="A"THENPRINT"ACES";:GOTO695
691 PRINTA$;
695 IFA$="A"THEN830
700 TW=VAL(A$)
710 FORT0=19TO1STEP-1
720 IFCL$(TW,T0,2)<>"   "THENTM=T0:T0=1:NEXT:T0=TM:GOTO770
730 NEXT
732 IFCL$(TW,1,2)="   "ANDLEFT$(CL$(FW,FE,2),1)="K"THENT0=0:GOTO800
740 GOSUB990
750 RETURN
770 AB$=CL$(FW,FE,2)
775 BELOW$=CL$(TW,T0,2)
780 GOSUB 2000:REM CHECK IF MATCH
790 IFOK$="NO"THEN740
800 GOSUB3200:REM MOVE THE STACK
810 CL=FW:GOSUB3100:REM REDRAW A COLUMN
815 CL=TW:GOSUB3100
820 RETURN
830 REM PLAY FROM A COLUMN TO ACES
832 FORFE=19TO1STEP-1
834 IFCL$(FW,FE,2)<>"   "THENTM=FE:FE=1:NEXT:FE=TM:GOTO840
836 NEXT
838 GOSUB990:RETURN
840 AB$=CL$(FW,FE,2)
850 GOSUB2300:REM PLAY TO ACES
851 IFOK$="NO"THEN740
853 REM CL$(FW,FE,1)="   "
854 CL$(FW,FE,2)="   "
855 IFFE>1THENCL$(FW,FE-1,2)=CL$(FW,FE-1,1)
856 CL=FW:GOSUB3100:REM REDRAW A COLUMN
860 RETURN
900 REM EXIT GAME
910 GOSUB1900
925 FORI=1TO20:A$=INKEY$:NEXT
930 GOSUB3400:PRINT "PLAY AGAIN?";
940 FORT1=1TOND:GOSUB1800:FORZZ=1TO200:A$=INKEY$:IFA$="N"THENZZ=200:NEXT:T1=ND:NEXT:GOTO970 
950 IFA$="Y"THENZZ=200:NEXT:T1=ND:NEXT:CLS:PRINT "RE-";:GOTO40
965 NEXT:NEXT:GOTO940
970 CLS:PRINT"BYE":END
990 REM BAD PLAY
992 PRINT@T*14+0,"CAN'T DO THAT!           ";:SOUND1,1
994 PRINT@T*15+0,"PRESS ANY KEY TO CONTINUE";
996 IFINKEY$=""THEN996
997 PRINT@T*14+0,"                         ";
998 PRINT@T*15+0,"                         ";
999 RETURN
1000 REM
1005 DN$=CHR$(209)+CHR$(147)+CHR$(146)
1009 IFCOL$="N"THEN1020
1010 FORI=1TO2:CR(I,1)=4:CR(I,2)=7:NEXT
1015 FORI=3TO4:CR(I,1)=0:CR(I,2)=7:NEXT
1019 GOTO1030
1020 FORI=1TO2:CR(I,1)=0:CR(I,2)=7:NEXT
1025 FORI=3TO4:CR(I,1)=7:CR(I,2)=0:NEXT
1030 SU$(1)=CHR$(178)+CHR$(130+48):SU$(2)=CHR$(177)+CHR$(128)
1031 SU$(3)=CHR$(163)+CHR$(130+32):SU$(4)=CHR$(161)+CHR$(128)
1035 FORI=1TO4:ACES$(I)="   ":NEXT
1040 FORI=2TO9:CA$(I)=RIGHT$(STR$(I),1):NEXT
1050 CA$(1)="A":CA$(10)="T":CA$(11)="J":CA$(12)="Q":CA$(13)="K"
1060 FORI=1TO4
1070 FORJ=1TO13
1080 K=(I-1)*13+J
1090 DK$(K)=CA$(J)+SU$(I)
1100 NEXT
1110 NEXT
1120 FORI=1TO7
1130 FORJ=1TO19
1140 CL$(I,J,1)="   ":CL$(I,J,2)="   "
1150 NEXT:NEXT
1160 NC=0
1170 RETURN
1200 REM SHUFFLE
1210 FORI=1TO52:ND$(I)="":NEXT
1220 FORI=1TO52
1230 R=RND(52)
1240 IFND$(R)=""THENND$(R)=DK$(I):GOTO1250
1241 GOTO1230
1250 NEXT
1260 FORI=1TO52
1270 DK$(I)=ND$(I)
1280 NEXT
1290 RETURN
1295 REM DISPLAY A CARD (C$)
1300 IFC$="   "THENPRINTC$;:PRINT@RL+T,C$;:PRINT@RL+64,C$;:RETURN
1350 PRINTC$;:POKEMC+RL,PEEK(MC+RL)-64
1360 RETURN
1500 REM DEAL THE GAME
1510 C=1
1520 FORPL=1TO7
1530 FORCL=1TO7
1535 IFCL<PLTHENCL$(CL,PL,1)="   ":CL$(CL,PL,2)="   ":GOTO1570
1540 CL$(CL,PL,1)=DK$(C)
1550 C=C+1
1560 IFCL=PLTHENCL$(CL,PL,2)=CL$(CL,PL,1):GOTO1570
1561 CL$(CL,PL,2)=DN$
1570 NEXT:NEXT
1580 CLS
1590 L=10:PRINT@1,"A=ACES":AC=0
1640 PRINT@T*4,1
1645 PRINT@T*3," 1   2   3   4   5   6   7"
1650 FORPL=1TO7
1660 FORCL=1TO7
1665 C$=CL$(CL,PL,2)
1670 RL=L(CL,PL):PRINT@RL,"";:IFC$="   "THEN1680
1675 IN$=C$:GOSUB3070:GOSUB1300:RL=RL+T:GOSUB3090
1680 NEXT:NEXT
1690 RETURN
1700 REM PREPARE TO PLAY
1710 FORI=1TO24
1715 J=I+28
1720 ND$(I)=DK$(J)
1730 NEXT
1740 FORI=25TO52
1750 ND$(I)=""
1760 NEXT
1770 ND=24
1780 RETURN
1800 REM SHOW DECK
1810 RL=444:PRINT@RL,"";:IFND<1THENPRINT"NONE";:PRINT@RL+T,"   ";:PRINT@RL+64,"   ";:RETURN
1820 C$=ND$(T1):IN$=C$:GOSUB3070:GOSUB1300:RL=RL+T:GOSUB3090
1830 PRINT@316,"CARD";:PRINT@T*10+28,T1;:PRINT@412,ND;:RETURN
1900 REM SHOW CARDS
1910 CN=0
1920 FORPL=1TO19:FORCL=1TO7:RL=L(CL,PL):PRINT@RL,"";
1935 C$=CL$(CL,PL,2):IFC$="   "THEN1960
1940 IFC$=DN$THENC$=CL$(CL,PL,1):CN=CN+1
1950 IN$=C$:GOSUB3070:GOSUB1300:RL=RL+T:GOSUB3090
1960 NEXT
1965 IFCN=0THENPL=20
1980 NEXT
1990 RETURN
2000 REM CHECK IF AB$ CAN GO ON BELOW$
2010 IN$=AB$:GOSUB3000:A=N:AS=SU
2020 IN$=BELOW$:GOSUB3000:BN=N:BS=SU
2030 OK$="YES"
2040 IFA+1<>BNTHENOK$="NO"
2050 IFAS<=2ANDBS<=2THENOK$="NO"
2060 IFAS>=3ANDBS>=3THENOK$="NO"
2070 RETURN
2200 REM REPACK DECK
2205 IFND=1THENT1=0:ND=0:RETURN
2210 FORI=T1+1TOND
2220 ND$(I-1)=ND$(I)
2230 NEXT
2240 ND=ND-1
2250 T1=T1-1
2260 IFT1<1THENT1=3
2280 IFT1>NDTHENT1=ND
2290 RETURN
2300 REM PLAY AB$ TO ACES
2310 IN$=AB$:GOSUB3000:A=N:AS=SU
2315 IN$=ACES$(AS):IF IN$="   " THENBN=0:GOTO2330
2320 GOSUB3000:BN=N
2330 IFA=BN+1THENOK$="YES":GOTO2340
2331 OK$="NO":RETURN
2340 ACES$(AS)=AB$
2350 IFAC=0THENAC=1:PRINT@0,"           ";
2355 RL=(AS-1)*4:PRINT@RL,"";:C$=AB$
2360 IN$=C$:GOSUB3070:GOSUB1300:RL=RL+T:GOSUB3090
2365 NC=NC+1:PRINT@T*4+27,"SCORE";:PRINT@T*5+28,NC;
2370 RETURN
3000 REM CHANGE IN$ TO NUM AND SUIT
3005 IFA$="   "THENN=0:SU=0:RETURN
3010 A$=LEFT$(IN$,1)
3020 IFA$="A"THENA$=" 1"
3030 IFA$="J"THENA$="11"
3040 IFA$="Q"THENA$="12"
3050 IFA$="K"THENA$="13"
3055 IFA$="T"THENA$="10"
3060 N=VAL(A$)
3070 A$=MID$(IN$,2,1)
3071 IFA$=CHR$(178)THENSU=1:RETURN
3072 IFA$=CHR$(177)THENSU=2:RETURN
3073 IFA$=CHR$(163)THENSU=3:RETURN
3074 IFA$=CHR$(161)THENSU=4:RETURN
3075 IFA$=CHR$(147)THENSU=5:RETURN
3080 SU=0:RETURN
3090 ONSUGOTO3091,3092,3093,3094,3095:RETURN
3091 PRINT@RL,CHR$(181);CHR$(191);CHR$(191);:PRINT@RL+T,CHR$(128);CHR$(189);CHR$(184);:RETURN
3092 PRINT@RL,CHR$(177);CHR$(191);CHR$(187);:PRINT@RL+T,CHR$(128);CHR$(189);CHR$(184);:RETURN
3093 PRINT@RL,CHR$(161);CHR$(175);CHR$(171);:PRINT@RL+T,CHR$(164);CHR$(173);CHR$(172);:RETURN
3094 PRINT@RL,CHR$(161);CHR$(175);CHR$(171);:PRINT@RL+T,CHR$(164);CHR$(173);CHR$(172);:RETURN
3095 PRINT@RL,CHR$(149);CHR$(159);CHR$(154);:PRINT@RL+T,CHR$(148);CHR$(156);CHR$(152);:RETURN
3100 EF=0:FORPL=1TO19:C$=CL$(CL,PL,2):RL=L(CL,PL):PRINT@RL,"";
3150 GOSUB1300:IFC$="   "ANDEF=0THENEF=L(CL,PL-1):IN$=CL$(CL,PL-1,2)
3160 NEXT
3165 IFEF>0THENRL=EF:PRINT@RL,"";:GOSUB3070:C$=IN$:GOSUB1300:RL=RL+T:GOSUB3090
3170 RETURN
3199 REM REDRAW A COLUMN
3200 REM COPY PART OF A COLUMN
3205 FP=FE:TP=T0
3207 IFTP=1ANDLEFT$(CL$(FW,FE,2),1)="K"THEN3220
3210 TP=TP+1
3220 CL$(TW,TP,1)=CL$(FW,FP,1)
3225 CL$(TW,TP,2)=CL$(FW,FP,2)
3230 REM CL$(FW,FP,1)="   "
3235 CL$(FW,FP,2)="   "
3240 FP=FP+1
3250 IFCL$(FW,FP,2)<>"   "THEN3210
3260 IFFE>1THEN3300
3270 CL$(FW,FP,1)="   "
3280 CL$(FW,1,2)="   "
3290 RETURN
3300 CL$(FW,FE-1,2)=CL$(FW,FE-1,1)
3310 RETURN
3400 REM EVALUATE GAME PERFORMANCE
3405 PRINT@T*14-1,NC;"PLACED ON ACES PILES.  ";:PRINT@T*15,"";
3410 SC=INT(NC/10)+1
3415 IFNC=52THENSC=7
3420 IFNC=0THENGOSUB3520:RETURN
3430 ONSCGOSUB3450,3460,3470,3480,3490,3500,3510
3440 RETURN:REM SCORE 0-9  10-19 20-29 30-39 40-49 50+
3450 PRINT"NOT SO GOOD.  ";:RETURN
3460 PRINT"NOT TOO BAD.  ";:RETURN
3470 PRINT"KEEP TRYING.  ";:RETURN
3480 PRINT"GOOD JOB!     ";:RETURN
3490 PRINT"VERY GOOD!    ";:RETURN
3500 PRINT"ALMOST...     ";:RETURN
3510 PRINT"YOU DID IT!   ";:WI=WI+1:RETURN
3520 PRINT"BAD SHUFFLE!  ";:RETURN
5000 REM INSTRUCTIONS
5010 CLS:PRINT "       KLONDIKE SOLITAIRE"
5030 PRINT"THIS PROGRAM PLAYS A SOLITAIRE  GAME. A DECK OF 52 CARDS IS" 
5040 PRINT"USED AND 28 CARDS ARE DEALT     INTO 7 COLUMNS. THE FIRST COL-" 
5050 PRINT"UMN AT THE LEFT HAS ONE CARD,   THE SECOND TWO, AND SO ON, UP" 
5060 PRINT"TO SEVEN IN COLUMN SEVEN. THE   LAST CARD OF EACH COLUMN IS " 
5070 PRINT"FACE UP AND THE REST ARE FACE   DOWN. ON EACH COLUMN YOU MAY"
5080 PRINT"BUILD IN DESCENDING SEQUENCE:   RED ON BLACK, SUCH AS THE TEN"
5090 PRINT"OF HEARTS ON THE JACK OF CLUBS  OR SPADES.":GOSUB5500
5100 PRINT"YOU CAN MOVE THE FACE UP CARDS  IN A COLUMN AS A UNIT. THE TOP"
5110 PRINT"CARD BEING MOVED MUST FIT IN    SEQUENCE AND COLOUR WITH THE"
5120 PRINT"CARD BEING MOVED UNDER IN THE   OTHER COLUMN. WHEN YOU UNCOVER"
5130 PRINT"A FACE-DOWN CARD ON A COLUMN,   IT WILL BE TURNED UP."
5140 PRINT"YOU ARE ALWAYS ENTITLED TO HAVE 7 COLUMNS, AND IF ONE IS"
5150 PRINT"ENTIRELY OPEN YOU MAY PUT A KINGIN THE SPACE. WHENEVER YOU"
5160 PRINT"FREE AN ACE, MOVE IT TO THE ACE FOUNDATIONS. ON THE ACES PILES":GOSUB5500
5170 PRINT"YOU MAY BUILD UP IN SUIT AND    SEQUENCE AND THEN TO WIN THE"
5180 PRINT"GAME, YOU HAVE TO BUILD EACH    SUIT UP TO A KING. A CARD MUST"
5190 PRINT"BE THE TOP CARD OF A COLUMN TO  BE PLAYED FROM, TO THE COLUMNS"
5200 PRINT"OF THE ACE FOUNDATIONS. ONCE    PLAYED ON THE ACE FOUNDATIONS,"
5210 PRINT"A CARD CANNOT BE REMOVED TO     HELP ELSEWHERE.":GOSUB5500
5240 PRINT"THE REMAINING 24 CARDS IN THE   DECK ARE USED AS THE STOCK."
5250 PRINT"EVERY THIRD CARD MAY BE TURNED  UP AND THE DECK MAY BE GONE"
5260 PRINT"THROUGH ANY NUMBER OF TIMES.    THE TOP CARD IS AVAILABLE FOR"
5270 PRINT"PLAY TO ANY COLUMN OR THE ACES  FOUNDATIONS. WHEN THE TOP CARD"
5280 PRINT"IS PLAYED, THE NEXT CARD WILL   THEN BE AVAILABLE. YOU WIN"
5290 PRINT"IF YOU CAN BUILD ALL 4 ACE      FOUNDATIONS UP TO KINGS."
5300 PRINT"YOU LOSE WHEN YOU CAN NOT MAKE  ANY FURTHER PLAYS.":GOSUB5500
5320 PRINT"PLAYS ARE CONTROLLED BY KEYBOARDCOMMANDS AS FOLLOWS:"
5330 PRINT"D = PLAY TOP CARD OF THE DECK TO    ACES (A) OR (#1-7)."
5340 PRINT"    ANSWER 'A' OR NUMBER 1-7        TO NEXT QUESTION TO"
5350 PRINT"    INDICATE WHERE THE CARD IS      TO BE MOVED."
5360 PRINT"C = GET NEXT CARD IN THE DECK."
5370 PRINT"Q = QUIT GAME AND TURN OVER ALL     FACE-DOWN CARDS."
5380 PRINT"#1-7 = PLAY CARDS FROM COLUMN#      TO ACES OR ANOTHER COLUMN.":GOSUB5500
5400 PRINT"AN ERROR MESSAGE WILL DISPLAY   IF AN INVALID RESPONSE IS"
5410 PRINT"GIVEN TO ANY QUESTION OR ANY    INVALID PLAYS ARE ATTEMPTED.":GOSUB5500
5420 RETURN
5500 PRINT@480,"   PRESS ANY KEY TO CONTINUE";
5510 IFINKEY$=""THEN5510
5520 CLS:RETURN
8000 MC=16384:T=32:FORCL=1TO7:R=((CL-1)*4):FORRL=1TO19
8010 ONRLGOSUB1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2
8020 NEXT:NEXT:RETURN
